livre de référence

les grandes étapes

Comment attribuer à V2 une variable avec les valeurs associées de trismestre

On va partir d’un vecteur de nombre allant de 1:12 ( les mois) et y associer les trismestres. Au sein d’un script R, on va devoir écrire un script avec un titre, un auteur, une license, une date, une version, une section TODO pour la suite des modifications, addresse mail,…

Le point de départ de notre vecteur

(V <- c(1,3,6,4,8,10,8,9))
[1]  1  3  6  4  8 10  8  9
(V2 <- sample(1:12, replace = TRUE))
 [1]  3  8  1  6 12  6 11  6 10 10  7  1

première idée : utilisation de boucles et de if

# fonction avec boucles et if
trimester <- function(x) {
  res <- integer(0)
  for(i in 1 : length(x)) {
    if (x[i] < 4) {
    res[i] <- 1
  }else if (x[i] < 7) {
      res[i] <- 2
  }else if (x[i] < 10) {
      res[i] <- 3
  }else res[i] <- 4
  }
  res
}
trimester(x = V)
[1] 1 1 2 2 3 4 3 3

avec ifelse

trimester1 <- function(x){
  ifelse(x <4, 1, 
         ifelse(x < 7,2, 
                ifelse(x < 10, 3, 4)))
}
trimester1(V)
[1] 1 1 2 2 3 4 3 3

avec %in%

La fonction %in% est vectorisable alors que la fonction if and else ne sont pas vectorisable.

# fonction avec %in%
# on prend un vecteur exemple
trimester2 <- function(x){
  if (!is.numeric(x)) 
    stop("x must be a numeric")
  if(any(x < 1  | x > 12))
    # au moins un résultat est vrai : any
    # tous vrai : all
    stop("x must be between 1 and 12")
  
  x2 <- as.integer(x)
  if(any(x !=x2))
    warning("non integer values (rounded down)")
  x <- x2
  
  res <- integer(length(x))
  # détermine si les élements de gauche se trouve dans la liste de droite
  res[x %in% 1:3] <- 1
  res[x %in% 4:6] <- 2
  res[x %in% 7:9] <- 3
  res[x %in% 10:12] <- 4
  res
}
trimester2(V)
[1] 1 1 2 2 3 4 3 3

Comparaison de trimestre(), trimestr1(), et de trimestre2()

La lisibilité va dépendre de la sensibilité du lecteur, par contre en terme de performance, la seconde solution sera beaucoup plus rapide

Benchmark

# vitesse
grand_vec <- sample(1:12, size = 1000000, replace = TRUE)
#trimester(grand_vec)
#trimester2(grand_vec)
#
bench::mark(trimester(grand_vec), trimester1(grand_vec), trimester2(grand_vec))
Some expressions had a GC in every iteration; so filtering is disabled.

On peut observer que la fonction trimester2() 3.26 fois plus rapide que trimester(). En terme de mémoire, trimester2() demande 2 fois moins de vitesse.

Autres solutions

On ne fait pas de comparaison mais on obtient notre valeur par calcul

#(V+2) %/% 3
trimester3 <- function(x){
  (x + 2) %/% 3
}
trimester3(V)
[1] 1 1 2 2 3 4 3 3

ce code est peu lisible mais il est 45 fois plus rapide.

bench::mark(trimester(grand_vec), trimester1(grand_vec), trimester2(grand_vec), trimester3(grand_vec))
Some expressions had a GC in every iteration; so filtering is disabled.
trimester4 <- function(x){
  rep(1:4, each = 3)[x]
}
trimester4(V)
[1] 1 1 2 2 3 4 3 3

Avec cette nouvelle fonction, la vitesse de calcul de trismestr4 est de 112 fois plus rapide.

bench::mark(trimester(grand_vec), trimester1(grand_vec),
            trimester2(grand_vec), trimester3(grand_vec), trimester4(grand_vec))
Some expressions had a GC in every iteration; so filtering is disabled.

Test et programmation défensive

la programmation défénsive a pour but d’arreter le plus vite possible une fonction lors d’une erreur avec un message explicite.

trimester2(1:12)
 [1] 1 1 1 2 2 2 3 3 3 4 4 4
library(testthat)
expect_equal(trimester2(1:12), 
             rep(1:4, each = 3))
expect_error(trimester3("a"))
# accepte seulement des valeurs numériques 
expect_error(trimester2("a"))
expect_error(trimester2(-1))
# nombre non entier accepté avec warning
expect_equal(trimester2(c(1.5,3.9, 4.1)), 
             c(1,1,2))
non integer values (rounded down)
expect_warning(trimester2(c(1.5,3.9, 4.1)), "non integer values \\(rounded down\\)") # requiert une expression régulière
LS0tCnRpdGxlOiAiRmFpcmUgZGVzIGZvbmN0aW9ucyIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKIyBsaXZyZSBkZSByw6lmw6lyZW5jZSAKCi0gUiBmb3IgRGF0YSBTY2llbmNlCgotIFIgcHJvZ3JhbW1pbmcKCiMgbGVzIGdyYW5kZXMgw6l0YXBlcwoKLSBQb3VyIHBhc3NlciBkJ2luc3RydWN0aW9ucyB2ZXJzIGxhIGZvbmN0aW9uIDogQ29kZSAtPiBFeHRyYWN0IGZ1bmN0aW9uCiAgICArIG5vbSBkZSBsYSBmb25jdGlvbiA8LSBmdW5jdGlvbigpCi0gUmVub21tZXIgbGUgdmFyaWFibGUgViBwYXIgeCA6IENvZGUgLT4gUmVuYW1lIGluIHNjb3BlCiAgICArIGRvbm5lciBkZXMgbm9tcyBleHBsaWNpdGVzIGF1eCBhcmd1bWVudHMKLSBSZW52b3llciBsZSByw6lzdWx0YXQKLSBWw6lyaWZpZXIgbGUgcsOpc3VsdGF0IGRlIGxhIGZvbmN0aW9uCgojIENvbW1lbnQgYXR0cmlidWVyIMOgIFYyIHVuZSB2YXJpYWJsZSBhdmVjIGxlcyB2YWxldXJzIGFzc29jacOpZXMgZGUgdHJpc21lc3RyZQoKT24gdmEgcGFydGlyIGQndW4gdmVjdGV1ciBkZSBub21icmUgYWxsYW50IGRlIDE6MTIgKCBsZXMgbW9pcykgZXQgeSBhc3NvY2llciBsZXMgdHJpc21lc3RyZXMuIEF1IHNlaW4gZCd1biBzY3JpcHQgUiwgb24gdmEgZGV2b2lyIMOpY3JpcmUgdW4gc2NyaXB0IGF2ZWMgdW4gdGl0cmUsIHVuIGF1dGV1ciwgdW5lIGxpY2Vuc2UsIHVuZSBkYXRlLCB1bmUgdmVyc2lvbiwgdW5lIHNlY3Rpb24gVE9ETyBwb3VyIGxhIHN1aXRlIGRlcyBtb2RpZmljYXRpb25zLCBhZGRyZXNzZSBtYWlsLC4uLgoKTGUgcG9pbnQgZGUgZMOpcGFydCBkZSBub3RyZSB2ZWN0ZXVyIAoKYGBge3J9CihWIDwtIGMoMSwzLDYsNCw4LDEwLDgsOSkpCihWMiA8LSBzYW1wbGUoMToxMiwgcmVwbGFjZSA9IFRSVUUpKQpgYGAKCiMjIHByZW1pw6hyZSBpZMOpZSA6IHV0aWxpc2F0aW9uIGRlIGJvdWNsZXMgZXQgZGUgaWYgCgpgYGB7cn0KIyBmb25jdGlvbiBhdmVjIGJvdWNsZXMgZXQgaWYKdHJpbWVzdGVyIDwtIGZ1bmN0aW9uKHgpIHsKICByZXMgPC0gaW50ZWdlcigwKQogIGZvcihpIGluIDEgOiBsZW5ndGgoeCkpIHsKICAgIGlmICh4W2ldIDwgNCkgewogICAgcmVzW2ldIDwtIDEKICB9ZWxzZSBpZiAoeFtpXSA8IDcpIHsKICAgICAgcmVzW2ldIDwtIDIKICB9ZWxzZSBpZiAoeFtpXSA8IDEwKSB7CiAgICAgIHJlc1tpXSA8LSAzCiAgfWVsc2UgcmVzW2ldIDwtIDQKICB9CiAgcmVzCn0KCnRyaW1lc3Rlcih4ID0gVikKYGBgCgojIyBhdmVjIGlmZWxzZQoKYGBge3J9CnRyaW1lc3RlcjEgPC0gZnVuY3Rpb24oeCl7CiAgaWZlbHNlKHggPDQsIDEsIAogICAgICAgICBpZmVsc2UoeCA8IDcsMiwgCiAgICAgICAgICAgICAgICBpZmVsc2UoeCA8IDEwLCAzLCA0KSkpCn0KdHJpbWVzdGVyMShWKQpgYGAKCiMjIGF2ZWMgJWluJQoKTGEgZm9uY3Rpb24gJWluJSBlc3QgdmVjdG9yaXNhYmxlIGFsb3JzIHF1ZSBsYSBmb25jdGlvbiBpZiBhbmQgZWxzZSBuZSBzb250IHBhcyB2ZWN0b3Jpc2FibGUuCgpgYGB7cn0KIyBmb25jdGlvbiBhdmVjICVpbiUKIyBvbiBwcmVuZCB1biB2ZWN0ZXVyIGV4ZW1wbGUKdHJpbWVzdGVyMiA8LSBmdW5jdGlvbih4KXsKICBpZiAoIWlzLm51bWVyaWMoeCkpIAogICAgc3RvcCgieCBtdXN0IGJlIGEgbnVtZXJpYyIpCiAgaWYoYW55KHggPCAxICB8IHggPiAxMikpCiAgICAjIGF1IG1vaW5zIHVuIHLDqXN1bHRhdCBlc3QgdnJhaSA6IGFueQogICAgIyB0b3VzIHZyYWkgOiBhbGwKICAgIHN0b3AoInggbXVzdCBiZSBiZXR3ZWVuIDEgYW5kIDEyIikKICAKICB4MiA8LSBhcy5pbnRlZ2VyKHgpCiAgaWYoYW55KHggIT14MikpCiAgICB3YXJuaW5nKCJub24gaW50ZWdlciB2YWx1ZXMgKHJvdW5kZWQgZG93bikiKQogIHggPC0geDIKICAKICByZXMgPC0gaW50ZWdlcihsZW5ndGgoeCkpCiAgIyBkw6l0ZXJtaW5lIHNpIGxlcyDDqWxlbWVudHMgZGUgZ2F1Y2hlIHNlIHRyb3V2ZSBkYW5zIGxhIGxpc3RlIGRlIGRyb2l0ZQogIHJlc1t4ICVpbiUgMTozXSA8LSAxCiAgcmVzW3ggJWluJSA0OjZdIDwtIDIKICByZXNbeCAlaW4lIDc6OV0gPC0gMwogIHJlc1t4ICVpbiUgMTA6MTJdIDwtIDQKICByZXMKfQp0cmltZXN0ZXIyKFYpCmBgYAoKIyMgQ29tcGFyYWlzb24gZGUgdHJpbWVzdHJlKCksIHRyaW1lc3RyMSgpLCBldCBkZSB0cmltZXN0cmUyKCkKCkxhIGxpc2liaWxpdMOpIHZhIGTDqXBlbmRyZSBkZSBsYSBzZW5zaWJpbGl0w6kgZHUgbGVjdGV1ciwgcGFyIGNvbnRyZSBlbiB0ZXJtZSBkZSBwZXJmb3JtYW5jZSwgbGEgc2Vjb25kZSBzb2x1dGlvbiBzZXJhIGJlYXVjb3VwIHBsdXMgcmFwaWRlCgojIyMgQmVuY2htYXJrCmBgYHtyfQojIHZpdGVzc2UKZ3JhbmRfdmVjIDwtIHNhbXBsZSgxOjEyLCBzaXplID0gMTAwMDAwMCwgcmVwbGFjZSA9IFRSVUUpCgojdHJpbWVzdGVyKGdyYW5kX3ZlYykKI3RyaW1lc3RlcjIoZ3JhbmRfdmVjKQojCmJlbmNoOjptYXJrKHRyaW1lc3RlcihncmFuZF92ZWMpLCB0cmltZXN0ZXIxKGdyYW5kX3ZlYyksIHRyaW1lc3RlcjIoZ3JhbmRfdmVjKSkKYGBgCgpPbiBwZXV0IG9ic2VydmVyIHF1ZSBsYSBmb25jdGlvbiB0cmltZXN0ZXIyKCkgMy4yNiBmb2lzIHBsdXMgcmFwaWRlIHF1ZSB0cmltZXN0ZXIoKS4gRW4gdGVybWUgZGUgbcOpbW9pcmUsIHRyaW1lc3RlcjIoKSBkZW1hbmRlIDIgZm9pcyBtb2lucyBkZSB2aXRlc3NlLiAKCiMjIyBBdXRyZXMgc29sdXRpb25zCgpPbiBuZSBmYWl0IHBhcyBkZSBjb21wYXJhaXNvbiBtYWlzIG9uIG9idGllbnQgbm90cmUgdmFsZXVyIHBhciBjYWxjdWwKCmBgYHtyfQojKFYrMikgJS8lIDMKCnRyaW1lc3RlcjMgPC0gZnVuY3Rpb24oeCl7CiAgKHggKyAyKSAlLyUgMwp9Cgp0cmltZXN0ZXIzKFYpCgpgYGAKY2UgY29kZSBlc3QgcGV1IGxpc2libGUgbWFpcyBpbCBlc3QgNDUgZm9pcyBwbHVzIHJhcGlkZS4KCmBgYHtyfQpiZW5jaDo6bWFyayh0cmltZXN0ZXIoZ3JhbmRfdmVjKSwgdHJpbWVzdGVyMShncmFuZF92ZWMpLCB0cmltZXN0ZXIyKGdyYW5kX3ZlYyksIHRyaW1lc3RlcjMoZ3JhbmRfdmVjKSkKYGBgCgpgYGB7cn0KdHJpbWVzdGVyNCA8LSBmdW5jdGlvbih4KXsKICByZXAoMTo0LCBlYWNoID0gMylbeF0KfQoKdHJpbWVzdGVyNChWKQpgYGAKIApBdmVjIGNldHRlIG5vdXZlbGxlIGZvbmN0aW9uLCBsYSB2aXRlc3NlIGRlIGNhbGN1bCBkZSB0cmlzbWVzdHI0IGVzdCBkZSAxMTIgZm9pcyBwbHVzIHJhcGlkZS4gCgpgYGB7cn0KYmVuY2g6Om1hcmsodHJpbWVzdGVyKGdyYW5kX3ZlYyksIHRyaW1lc3RlcjEoZ3JhbmRfdmVjKSwKICAgICAgICAgICAgdHJpbWVzdGVyMihncmFuZF92ZWMpLCB0cmltZXN0ZXIzKGdyYW5kX3ZlYyksIHRyaW1lc3RlcjQoZ3JhbmRfdmVjKSkKYGBgCgojIyBUZXN0IGV0IHByb2dyYW1tYXRpb24gZMOpZmVuc2l2ZQoKbGEgcHJvZ3JhbW1hdGlvbiBkw6lmw6luc2l2ZSBhIHBvdXIgYnV0IGQnYXJyZXRlciBsZSBwbHVzIHZpdGUgcG9zc2libGUgdW5lIGZvbmN0aW9uIGxvcnMgZCd1bmUgZXJyZXVyIGF2ZWMgdW4gbWVzc2FnZSBleHBsaWNpdGUuCgpgYGB7cn0KdHJpbWVzdGVyMigxOjEyKQoKbGlicmFyeSh0ZXN0dGhhdCkKZXhwZWN0X2VxdWFsKHRyaW1lc3RlcjIoMToxMiksIAogICAgICAgICAgICAgcmVwKDE6NCwgZWFjaCA9IDMpKQpleHBlY3RfZXJyb3IodHJpbWVzdGVyMygiYSIpKQojIGFjY2VwdGUgc2V1bGVtZW50IGRlcyB2YWxldXJzIG51bcOpcmlxdWVzIApleHBlY3RfZXJyb3IodHJpbWVzdGVyMigiYSIpKQpleHBlY3RfZXJyb3IodHJpbWVzdGVyMigtMSkpCiMgbm9tYnJlIG5vbiBlbnRpZXIgYWNjZXB0w6kgYXZlYyB3YXJuaW5nCmV4cGVjdF9lcXVhbCh0cmltZXN0ZXIyKGMoMS41LDMuOSwgNC4xKSksIAogICAgICAgICAgICAgYygxLDEsMikpCmV4cGVjdF93YXJuaW5nKHRyaW1lc3RlcjIoYygxLjUsMy45LCA0LjEpKSwgIm5vbiBpbnRlZ2VyIHZhbHVlcyBcXChyb3VuZGVkIGRvd25cXCkiKSAjIHJlcXVpZXJ0IHVuZSBleHByZXNzaW9uIHLDqWd1bGnDqHJlCmBgYAoK